r+VERSION = 3.00colbasePixelsClass1 collectioncolbase collection_ws3.h&- wsparmzoom5_ws3.h&- wshandler_ws3.hPixelsClass_ws3.h&-wsparms_ws3.hPixelsClass13_ws3.hPixelsClassformLabel31_custom wshandlercustomClassformwsparmswsparmscmdZoom commandbuttonwsparmsJHeight = 23 Width = 23 itemclass = itemclasslib = Name = "colbase"  wsparmzoomlabeleArial, 0, 9, 5, 15, 12, 32, 3, 0 Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 Tahoma, 1, 8, 6, 13, 11, 26, 2, 0 itemclass Name of class used for new objects added to collection. itemclasslib Name of class library used for new objects added to collection. *newitem Method to add new items to the collection based on ItemClass properties.  wsparmzoomzPROCEDURE Click LOCAL loZoomForm loZoomForm=NEWOBJECT("wsparmzoom", THISFORM.ClassLibrary) loZoomForm.Show() ENDPROC  commandbuttonLabel3CArial, 0, 9, 5, 15, 12, 32, 3, 0 Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 label wsparmzoom1 %U7 TC wsparmzoom CU LOZOOMFORMTHISFORM CLASSLIBRARYSHOWClick,1q1o) %m|U C CUTHISFORM UPDATEPARMSRELEASEClick,12=)  %ShbU CUTHISFORMRELEASEClick,12%) _base.vcx colclient containercolparms_ws3client.vcx cmdCancel1 coloperationsPixelsClass1colbase coloperations collection_ws3client.vcxPROCEDURE newitem LPARAMETERS tcKey LOCAL lcClasslib, lHadError, loItem IF VARTYPE(THIS.ItemClasslib)#"C" OR EMPTY(THIS.ItemClasslib) lcClasslib = THIS.ClassLibrary ELSE lcClasslib = THIS.ItemClasslib ENDIF IF !FILE(lcClasslib) OR EMPTY(THIS.ItemClass) RETURN "" ENDIF TRY loItem=NEWOBJECT(THIS.ItemClass, lcClasslib) IF VARTYPE(tcKey)="C" AND !EMPTY(tcKey) THIS.Add(loItem, tcKey) ELSE THIS.Add(loItem) ENDIF CATCH lHadError=.T. ENDTRY RETURN IIF(lHadError, "", loItem) ENDPROC 0PROCEDURE Click THISFORM.Release() ENDPROC  commandbutton commandbutton wsparmzoom colclientsPixelsClasscolbase"AutoSize = .T. FontName = "Tahoma" FontSize = 8 FontUnderline = .F. WordWrap = .T. BackStyle = 0 Caption = 'Enter value for your parameter. Precede the value with an "=" character if it is an expression.' Height = 28 Left = 12 Top = 12 Width = 303 TabIndex = 1 Name = "Label3" Top = 72 Left = 348 Height = 22 Width = 60 FontName = "Tahoma" FontSize = 8 Cancel = .T. Caption = "Cancel" TabIndex = 4 Name = "cmdCancel"  g%yU%>C CUVALUETHISFORMEDTVALUERELEASEClick,1Q2Z)ePROCEDURE Click REPLACE Value WITH ALLTRIM(THISFORM.edtValue.Value) THISFORM.Release() ENDPROC Top = 48 Left = 348 Height = 22 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "OK" Default = .T. TabIndex = 3 Name = "cmdOK" cmdOK commandbutton commandbutton wsparmzoomedtValueeditboxeditboxlabelformlabelwsparms lblSyntaxlabel1 colclients collectionlabelwsparmslbldesc3KHeight = 23 Width = 23 itemclass = colOperation Name = "coloperations" FontName = "Tahoma" FontSize = 8 Height = 108 Left = 12 TabIndex = 2 Top = 48 Width = 324 ControlSource = "" Name = "edtValue" Top = 216 Left = 12 Height = 22 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "\ > %%CloParm.InputValuebUT %CC(%C=[CR] >CC>\ >>C_+TC6#)T _vfptempwsULOPARMLEVALUETHIS OCOLPARMSCOUNT PARAMETERTYPEVALUE LBLSYNTAXCAPTIONWSSYNTAXPARMNAMEPARMTYPE INPUTVALUETHISFORMGRID1 SCROLLBARS RECORDSOURCE<~5-CO InputValueCUTHIS OCOLPARMSITEM ADDPROPERTYVALUEsetupws, updateparms#1AArAA1A!A$QQQAAAAQ2A2%17)_PROCEDURE setupws * Requires a colParm Collection object * * Example code calling this form -- assumes oColParms is object that: * loParmForm = NEWOBJECT("wsparms", IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_ws3client.vcx") * loParmForm.oColParms = THISFORM.colParms * loParmForm.SetupWS() * loParmForm.Show(1) LOCAL loParm, leValue IF TYPE("THIS.oColParms.Count")="U" RETURN ENDIF IF THIS.oColParms.Count=0 RETURN ENDIF * Open cursor to fill parmaters. IF USED(TMPWSCURSOR) SELECT TMPWSCURSOR ZAP ELSE SELECT 0 CREATE CURSOR TMPWSCURSOR(Parameter c(20), Type c(20), Value c(127)) && account for DBCS ENDIF THIS.lblsyntax.Caption = THIS.oColParms.wsSyntax * Fill cursor with collection values FOR EACH loParm IN THIS.oColParms APPEND BLANK REPLACE Parameter WITH loParm.Parmname REPLACE Type WITH loParm.ParmType IF TYPE("loParm.InputValue") # "U" leValue = loParm.InputValue IF VARTYPE(leValue)="C" IF LEFT(leValue,1)="[" AND RIGHT(leValue,1)="]" REPLACE Value WITH SUBSTR(leValue,2,LEN(leValue)-2) ELSE REPLACE Value WITH leValue ENDIF ELSE REPLACE Value WITH TRANSFORM(leValue) ENDIF ENDIF ENDFOR THISFORM.Grid1.ScrollBars=IIF(THIS.oColParms.Count>3,2,0) GO TOP THIS.Grid1.RecordSource=TMPWSCURSOR ENDPROC PROCEDURE updateparms SCAN THIS.oColParms.Item(RECNO()).AddProperty( "InputValue", ALLTRIM(value)) ENDSCAN ENDPROC DataSession = 2 Height = 244 Width = 500 Desktop = .T. DoCreate = .T. AutoCenter = .T. BorderStyle = 2 Caption = "Parameters" MaxButton = .F. MinButton = .F. WindowState = 0 AlwaysOnTop = .T. Name = "wsparms" parmname Name of the parameter. parmtype The parameter data type. inputvalue The initial value to set to the parameter. Can be an expression if preceded by "=" character. returnvalue The output value returned by the parameter (used if passed in by reference). isbyref Whether parameter is passed in by reference. inputcontrol Reference to control that provides initial value for parameter. Requires the InputProperty property. inputproperty Reference to control property that provides initial value for parameter. Requires the InputControl property. typedvalue Contains the actual typed output value based on the Parmtype property. }parmname = parmtype = inputvalue = returnvalue = inputcontrol = inputproperty = typedvalue = Name = "colparm" customclientname = objectref = bindsource = bindtarget = bindprop = dstable = dsfield = nodename = dsuseexistingcursor = .T. bindflags = -1 Name = "colclient" )Top = 5 Left = 48 Name = "colClients"  coloperationPixels container coloperationWidth = 82 Height = 36 wsmethod = wsparmnum = 0 wsoperation = wsdesc = nparmprompt = 1 errornumber = 0 errormessage = errordetail = soaperrorcode = soaperrorstring = soaperrordetail = Name = "coloperation"  wssyntax Actual Web service method syntax, which includes inline parameters. *getdatatype Returns the data type of a parameter. *getparm Returns parameter value based on type. *genparms Routine to generate parameter collection items based on the wsSyntax property. X ??jC%U/$%CC C JTbT%C0 C  BTC%CCC CC TaBC6U TCKEY LCCLASSLIB LHADERRORLOITEMTHIS ITEMCLASSLIB CLASSLIBRARY ITEMCLASSADDnewitem,1qBAAaQAAr1)?clientname Friendly name of the client used in the builder. objectref Full path to the control binding to the Web service. bindsource Name of the parameter or returnvalue populated by the Web service used to bind to the client control. bindtarget Name of the property on the client control to bind Web service parameter or returnvalue. bindprop Name or custom property or method used to trigger event to call Web service. linvokeatstart Whether to call Web service and bind to client control at startup. dstable Table name if Web service returns an ADO .NET Dataset. dsfield Field name if Web service returns an ADO .NET Dataset. nodename Name of node (value) to use if Web service returns a complex object (XMLDOMNodeList). lalwayscallwebservice Whether to always call the Web service even if previous call was just made. dsuseexistingcursor Whether the ADO .Net Dataset should use an existing cursor if already open or always create new one. bindflags Flags passed to the BINDEVENTS() call. Advanced feature. ?Height = 25 Width = 53 wsdl = wsml = service = port = returnvalue = webserviceid = wsmethod = soaperrorcode = soaperrordetail = wsname = wssyntax = ldisplayerrors = .T. nconnecttries = 2 wsobject = soaperrorstring = lautoconvert = .T. offlinedbf = cofflinealias = lautoclosecursors = .T. xmladapterclass = xmladapterclasslib = clastevent = displaymode = 0 ccontainer = lautobindcontrols = .T. luseraiseevents = .T. builderx = (HOME()+"ffc\_ws3utils,wsbuilder") lautobuilder = .T. lautosetobjectrefs = .T. Name = "wshandler" wsmethod Actual name of Web service operation (method) to invoke. wsparmnum Number of parameters for the Web service operation. loffline Whether to cache Web service parameters and results offline for use later if cannot connect online. linvokeatstart Whether to invoke at startup. wsoperation Friendly name of Web service operation. wsdesc Friendly description of the operation. nparmprompt Numeric code whether to prompt for parameters or use pre-populated ones. returnvalue Reference to return value of Web service call. lhaderror Whether an error occurred. errornumber Error number of an error that occurred. errormessage Normal message of an error that occurred. errordetail Detailed message of an error that occurred. soaperrorcode SOAP specific error code. soaperrorstring SOAP specific error string. soaperrordetail SOAP specific error detail. lusedoffline Whether the last Web service call was made to cached offline data. lskipwebservicecall Whether to skip making a new Web service call if one already made by another client. oadapter Object reference to XMLAdapter if ADO .Net Dataset was returned by the Web service call. ocomplex Object reference to object created if complex type (XMLDOMNodeList) was returned by the Web service call.  < # # {% w UTCCf H% STRINGF BC BOOLEANh BL DATETIME BT DATE BD INT BN INTEGER BN DOUBLE  BN DECIMAL- BN LONGL BN SHORTl BN FLOAT BN BYTE BN ANY BC2 BCUTCTYPE  TCC TC Hn CC  ZTC %COTCC >%CO CC C Ch 6leValue = loObject.&lcProp. VTC  CC C T" CC ==TCC\2TC %CT  B%CC?TC_ HP Cb NLTCg HH  CC8GTC82H T(D%C T/TC T. T! L9 Hk5- CTrueCYes  Ta6 CFalseCNo C  T- CTCCg-a625TCC9-C6 DTC#3TCCC C$CCiCHC%$6 TTC5TCCC CCCiCHC%6T  BUNPARM OWSHANDLERLCTYPELOOBJECTLCPROPDT LNLASTVALUEILEVALUETHIS GETDATATYPEITEMPARMTYPE INPUTVALUE INPUTCONTROL INPUTPROPERTY GETOBJECTREF TYPEDVALUE@CT%CNB-TC()TC,(9 CCcolParm TC ,#T  CC#T  CC%T  C@ULCPARMSLNPARMSLCMETHODILCPARMTHISREMOVEWSSYNTAXADD CLASSLIBRARYITEMPARMNAMEPARMTYPEISBYREF getdatatype,getparmgenparms1qqQAqQaaQAA3QAA!AACAUA!"AAAAAA!aA!1!QA3rqAAr11QA24"R %g )# wsdl URI reference to Web service WSDL. wsml URI reference to Web service WSML -- for special SOAP Toolkit servers only. service Name of Web service. port Name of Web service port to use. returnvalue Value returned from the Web service call. webserviceid Web service ID. wsmethod Name of Web Service operation to call. Note: preference is to use the Operations collection instead. lhaderror Whether an error occurred. soaperrorcode Specific SOAP error code. soaperrordetail Specific SOAP error detail. wsname Name of Web service. wssyntax Syntax for Web service operation. lskiperror Whether to skip over an error. ldisplayerrors Whether to display errors. nconnecttries Number of time to attempt connecting to the Web service. wsobject Reference to SOAP object that is wrapped by this class. lforceoffline Always use offline cache data if it is available (usually for Testing purposes). errornumber Error number. soaperrorstring Specific SOAP error message. errordetail Detail of error. errormessage Message for error. lhasclients If there are clients that need to be bound to. lautoconvert Whether to automatically convert values returned by the Web service to a value handled by the client. oadapter Reference to XMLAdapter if using ADO .Net Dataset. lhadstartup Reserved. lverboseerror Whether to show detailed error messages. offlinedbf Name of offline cache table. cofflinealias Name of offline alias. lautoclosecursors Whether to close cursors opened from ADO .Net Datasets automatically. xmladapterclass Name of XMLAdapter class to use for ADO .Net Datasets. xmladapterclasslib Name of XMLAdapter class library to use for ADO .Net Datasets. clastevent Reserved. displaymode Controls how messages are displayed. 0 - use Status Bar. 1 - use WAIT WINDOW. ccontainer Path reference to container for VCX classes. lautobindcontrols Automatically set BindControls to .T. after calling CursorFill at startup. luseraiseevents Use RaiseEvents when making method call binding. *invoke Main routine to call Web service. *startupinvoke Routine to do event binding initially so that we can setup event bindings to clients. *connectws Call to connect to Web service via SOAP. *setupoperations This virutal method is filled in by the Web Service builders and contains details on the Operation and Client objects bound to the Web service. *calloperation Call a partcular operation. *wsobject_access Access method for SOAP object. *setupclients Routine that iterates through all the registered operations and clients and does event bindings. *invokeclient Main routine used by client to call Web service and bind to the client control. *setupclient Routine to setup parameters needed by SOAP handler. This is used mainly for calls made through code. *getobjectref Returns reference to control specified by client. *converttype Converts data to value needed by client. *displayerror Controls display of errors. *gendataset Method to generate ADO .Net Dataset from XMLDOMNode object returned by SOAP. *displaystatus Displays status such as when connecting to Web service. *setconnectorproperties Virtual method to setup SOAP connector setting. *setclientproperties Virtual method to setup SOAP client setting. *callclients Calls all clients of an operation. *recordws Routine to record input parameters, output parameters and return value for offline cache. *playbackws Routine to return offline cache data if Web service is not available. *openoffline Routine to open offline data cache. *beforeopencursor Called before opening ADO .Net Dataset. *afteropencursor Called after opening ADO .Net Dataset. ^acursors[1,0] Array of ADO .Net Dataset cursors opened by class. *checknumber Fixes up extraneous decimals returned by Web service float types. *isdataset Whether the Web service returned a complex type which is an ADO .Net Dataset. *iscomplex Whether the Web service returned a complex type. *getcomplex Creates object from complex type returned by Web service. *gettableid Returns ID of ADO .Net Dataset. *opendstable Routine to open ADO .Net Dataset table. PROCEDURE getdatatype LPARAMETERS tcType tcType=UPPER(ALLTRIM(tcType)) DO CASE CASE tcType="STRING" RETURN "C" CASE tcType="BOOLEAN" RETURN "L" CASE tcType="DATETIME" RETURN "T" CASE tcType="DATE" RETURN "D" CASE tcType="INT" RETURN "N" CASE tcType="INTEGER" RETURN "N" CASE tcType="DOUBLE" RETURN "N" CASE tcType="DECIMAL" RETURN "N" CASE tcType="LONG" RETURN "N" CASE tcType="SHORT" RETURN "N" CASE tcType="FLOAT" RETURN "N" CASE tcType="BYTE" RETURN "N" CASE tcType="ANY" RETURN "C" OTHERWISE RETURN "C" ENDCASE ENDPROC PROCEDURE getparm LPARAMETERS nParm, oWSHandler * Parameter values are initially set to the InputValue property. This is always set as a string since it is stored * inside of the SetupClients snippet or input from the Parms dialog. The TypedValue contains the actual typed * based on the Parmtype property. LOCAL lcType, loObject, lcProp, dt, lnLastValue, i, leValue lcType = THIS.GetDataType(THIS.Item(nParm).ParmType) leValue = THIS.Item(nParm).InputValue && this is initially set to character type since it is stored in memo * Get stored value or evaluate from control or expresison. DO CASE CASE !EMPTY(THIS.Item(nParm).InputControl) * If user wants to specify a control as the parameter source, get it here. Requires WSHandler object lcProp = THIS.Item(nParm).InputProperty && get name of property IF VARTYPE(oWSHandler)="O" loObject = oWSHandler.GetObjectRef(THIS.Item(nParm).InputControl) ENDIF IF VARTYPE(loObject)="O" AND VARTYPE(lcProp)="C" AND !EMPTY(lcProp) AND PEMSTATUS(loObject, lcProp, 5) leValue = loObject.&lcProp. ELSE leValue = THIS.Item(nParm).InputValue ENDIF CASE VARTYPE(THIS.Item(nParm).InputValue) # "C" leValue = "" CASE LEFT(THIS.Item(nParm).InputValue, 1) = "=" leValue = EVALUATE(SUBSTR(leValue,2)) OTHERWISE leValue = THIS.Item(nParm).InputValue ENDCASE * Check if we already have correct type here and just return it. IF VARTYPE(leValue)=lcType THIS.Item(nParm).TypedValue=leValue RETURN leValue ENDIF * If we have an expression or type from control that is not * same type as ParmType, we need to first transform it to * a character string. IF VARTYPE(leValue)#"C" leValue=TRANSFORM(leValue) ENDIF * Handle type conversion here DO CASE CASE lcType="C" * No need to do anything CASE lcType="N" leValue = VAL(leValue) DO CASE CASE leValue = 0 * Do nothing CASE MOD(INT(leValue), leValue)=0 * Quick check for integer first leValue = INT(leValue) OTHERWISE * Reduce out extra decimals lnLastValue = leValue FOR i = 18 TO 1 STEP -1 IF ROUND(leValue, m.i) - leValue = 0 lnLastValue = ROUND(leValue, m.i) LOOP ENDIF leValue = lnLastValue EXIT ENDFOR ENDCASE CASE lcType="L" DO CASE CASE ATC(TRUE_LOC, leValue)#0 OR ATC(YES_LOC, leValue)#0 leValue = .T. CASE ATC(FALSE_LOC, leValue)#0 OR ATC(NO_LOC, leValue)#0 OR EMPTY(leValue) leValue = .F. CASE ISDIGIT(leValue) leValue=IIF(VAL(leValue)=0,.F.,.T.) OTHERWISE leValue=IIF(ISALPHA(leValue),.F.,EVALUATE(leValue)) ENDCASE CASE lcType="D" dt = CTOD(leValue) leValue = IIF(EMPTY(leValue) OR EMPTY(dt), DATE(), DATE(YEAR(dt), MONTH(dt), DAY(dt)) ) CASE lcType="T" dt = CTOT(leValue) leValue = IIF(EMPTY(leValue) OR EMPTY(dt), DATETIME(), DATETIME(YEAR(dt), MONTH(dt), DAY(dt)) ) ENDCASE THIS.Item(nParm).TypedValue=leValue RETURN leValue ENDPROC PROCEDURE genparms * This routine takes method syntax and generates a Parameter collection object LOCAL lcParms, lnParms, lcMethod, i, lcParm THIS.Remove(-1) * Syntax statement lcMethod=THIS.wsSyntax IF EMPTY(lcMethod) RETURN .F. ENDIF lcParms = STREXTRACT(lcMethod,"(",")") lnParms = GETWORDCOUNT(lcParms,",") FOR i = 1 TO lnParms THIS.Add(NEWOBJECT("colParm",THIS.ClassLibrary)) lcParm = GETWORDNUM(lcParms, m.i, ",") THIS.Item(m.i).ParmName = ALLTRIM(GETWORDNUM(lcParm, 1)) THIS.Item(m.i).ParmType = ALLTRIM(GETWORDNUM(lcParm, 3)) THIS.Item(m.i).IsByRef = ATC("@",lcParm)#0 ENDFOR ENDPROC j[ BjBj6%])h`U' %COJB-%C LtT -T T T% (T  TY#T C )TCC @6a*TlaParms[C _]%  T,T ()T - T% C  =C-Attempting to connect to XML Web service..... 'leRetVal = THIS.wsObject.&lcMethod.  (#T aT T %C  T  T  T  8 C T  % 8 (:  ReturnValueCC  T!-TC T"T "%#4C $% # %C %T!a T- B U& TOOPERATIONLCMETHODLERETVALLCPARMS LCBYREFCHAR LOEXCEPTIONLOPARMS LHADERRORLAPARMSITHIS LFORCEOFFLINEWSMETHODCOLPARMSCOUNTGETPARMITEMISBYREF CONNECTWS DISPLAYSTATUS ERRORNUMBERERRORNO ERRORMESSAGEMESSAGEWSOBJECT FAULTCODE SOAPERRORCODESOAPERRORSTRING FAULTSTRINGSOAPERRORDETAILDETAIL ADDPROPERTY CHECKNUMBER LUSEDOFFLINE RETURNVALUELOFFLINERECORDWS PLAYBACKWSZ%CTHISFORMbOF*CActivate StartupInvoke CUTHISFORMTHIS SETUPCLIENTS $%CC C 6B-%CCbT%CCT5%CCC .asmx?wsdl T(gT-T T T T T T=C-Attempting to connect to XML Web service.....&TCMSSOAP.SoapClient30N C(C C (-TaT T  H]) CO8T (Could not instantiate SOAP client class. C T T T2)T  Other error. C!%  c!%T B U LOSOAPCLIENTITHISWSDLSERVICEPORTWSML NCONNECTTRIES LHADERROR ERRORDETAIL ERRORMESSAGE ERRORNUMBER SOAPERRORCODESOAPERRORSTRINGSOAPERRORDETAIL DISPLAYSTATUSWSOBJECTSETCLIENTPROPERTIES MSSOAPINITSETCONNECTORPROPERTIES LOEXCEPTIONERRORNOMESSAGE FAULTCODE FAULTSTRINGDETAILsTaITC%C fCf TT -!T-%COB-%  B %%   gTCwsParmsT CCTCTT  % cTTTTTTTT/There was an error calling the XML Web service.C C C C  HN C  T C T C  T C 7T2NTCC BU TCOPERATION LOOPERATIONLSUCCESS LCERRSTRINGLOITEM LOPARMFORMTHIS LSKIPERROR COLOPERATIONS WSOPERATION LHADERRORLSKIPWEBSERVICECALLCOLPARMSCOUNT NPARMPROMPT CLASSLIBRARY OCOLPARMSSETUPWSSHOWINVOKE RETURNVALUE SOAPERRORCODESOAPERRORSTRINGSOAPERRORDETAIL ERRORNUMBER ERRORMESSAGE ERRORDETAIL LVERBOSEERROR DISPLAYERRORA!%C THIS.wsobjectbO. C BUTHIS CONNECTWSWSOBJECTE'   &%CTHIS.colOperationsbO`B%C T C . T   (ST C .B%C fCfCloObject.ParentbO  +T.$T C 6+C =%CloObject.ParentbOCfFORMSET !TT . T  T T TC  TTCC OperationIDTC %CO.T/%C_KEYhCh CiThe Web service could not be bound to the following control because the binding property already exists: C C C C .C C C C CYou must specify a different binding property name which is unique. . Hn Ch 7C- ' CPropertyChnC-  H1& CN  &%C CursorAdapter T5TCCPropertyCh621T$C InvokeClientC_KEY %T  H' CPropertyChloObject.&lcProp. = .T. @ C CursorFillC CursorAdapter t C%CC p#)%   lTa23%ChC L  CloObject.&lcProp T!aTT >T!-U" LOOPERATIONLOCLIENTLCKEYLNCOUNTLOOBJECTLNCOUNT2LCKEY2LNFLAGSLCPROPI LNOBJECTSLCNAMETHIS CCONTAINERNAMEPARENT BASECLASS COLOPERATIONSGETKEY COLCLIENTS ADDPROPERTY GETOBJECTREF OBJECTREFBINDPROP DISPLAYERROR BINDFLAGSLINVOKEATSTART CLASTEVENT CURSORFILLTHISFORM BINDCONTROLSLAUTOBINDCONTROLSLUSERAISEEVENTSLSKIPWEBSERVICECALL C      !"#$%&'()   T" T T!C TCT#CT#_KEYlcKey = loControl.&lcKey. T*+*,(-.%C -/TC -0!TC1*,T"2T3%49T5-%C1*6 YBT7!%C ReturnValue8%C9fCfT7!TC T%CW H  C*:%C**; |;T!.Error generating ADO .Net Dataset for binding. T<*<T$C>*=T'C$<?0%C'*@ =MT!@Error opening cursor from ADO .Net Dataset loaded in XMLAdapter.  T&%CA 'B%CAfCCfT&A!+T&CC& &C'B0C6 C*DC*E T(a H3 (@5 C*:C CursorAdapter> G_ TFXMLC oAdapter_WS'G THTHIS.oAdapter_WS' CC"C(none)"  O %C"h g-lePropType = VARTYPE(loControl.&lcTarget) TC*Iz%C RecordSource"C ControlSource" C"fVALUE  CC CCC=@> Property: <>  <>C*PUQP1P2P3P4P5P6P7P8P9P10P11P12P13P14P15P16 LAEVENTINFO LAEVENTSALLILOCLIENT LOOPERATIONLCKEYLCCURSORLERETVALLOPARM LCBINDSOURCELOERRLCERRMSG LOCONTROLLOFIELD LERETTYPE LEPROPTYPELCNODE LCTMPERRMSGLCTARGETLCPROP LNALIASID LNSAVEAREALCFIELDLOTABLE LHADERROR LCNODENAMETHIS CLASTEVENT COLOPERATIONS COLCLIENTSCOUNTGETKEYITEM OPERATIONID BINDTARGET BINDSOURCELALWAYSCALLWEBSERVICELSKIPWEBSERVICECALL CALLOPERATION RETURNVALUECOLPARMSPARMNAME ISDATASET GENDATASETOADAPTER GETTABLEID BASECLASSTABLES OPENDSTABLEDSFIELDFIELDSALIAS ISCOMPLEX GETCOMPLEXDATASOURCETYPE ADDPROPERTY SELECTCMD CONVERTTYPEDSTABLEDSUSEEXISTINGCURSOR ROWSOURCETYPEOCOMPLEXNODENAMEMESSAGE DISPLAYERRORbTTTT B U LCURI LCSERVICELCPORTLCWSMLTHISWSDLSERVICEPORTWSMLWSOBJECT  H CTHISFORMbO T +a$%CloControl.ParentbO|!TN CTHISFORMSET.DataEnvironmentbOCfCC.f TK CTHISFORM.DataEnvironmentbOCfCC.f MT/ C C fCC.f T $loControl = THISFORM.&loControl. 2 T%C 8T CC.CC.6%C.TCC.+IF TYPE("loControl.&lcObject.")="O"RETURN loControl.&lcObject. B BU TCOBJECTREFLCOBJECT LOCONTROLTHISPARENT THISFORMSETDATAENVIRONMENTNAMETHISFORMDECLASS CCONTAINER H#  = B/ Ct CC CC u B  B T H   C,%L$TC TrueFalse6(TC_ N HK ClTCg LTC6 CDTTCCC ]gT2 T- L0 H, N,TC-a6 C HK- CTrueCYes  Ta6 CFalseCNo C  T- CTCCg-a62TCC9-C62, T- D HO' NCC,Q TC ] TTC CTC#2 TC$ T H' NCC,Q ;TC ] D]TC CTC2 TC2 BU TEINPUTVALUE TCINPUTTYPE TCOUTPUTTYPELERETVALTHIS LAUTOCONVERTE%>'CXML Web Service ErrorxU TCERRMESSAGETHISLDISPLAYERRORS %COy/%CtoSource.ReturnValue.LengthbNeB-T?TCCC C  xmlAdapter65TCCC C 6T C% =CC  i$CC C  T  Ta B U TCXMLSOURCETOSOURCE LHADERRORLCCLASS LCCLASSLIB RETURNVALUETHISXMLADAPTERCLASSXMLADAPTERCLASSLIBOADAPTERLENGTHATTACHITEMTABLESCOUNT%CN/T%CCC  H^ xG&( R 2B H  G&(  R,:2ULCMSGTHIS DISPLAYMODEUUxTaITC%C fCf TT -!T-%COB- cT TC &%COCh 7.T HXQ' CPropertyChloObject.&lcProp. = .T. @ C CursorFillC CursorAdapter  C2Q3%ChCL  1CMloObject.&lcProp TaT-U TCOPERATION LOOPERATIONLOCLIENTLOOBJECTLCPROPLOITEMTHIS LSKIPERROR COLOPERATIONS WSOPERATION LHADERROR COLCLIENTSBINDPROP GETOBJECTREF OBJECTREF CLASTEVENT BASECLASS CURSORFILLLUSERAISEEVENTSLSKIPWEBSERVICECALL' J( TCW T%C uB- Hp C U T C OTC _2pT(object)T  Hl C  M(`.( -' 4. <>4. <> TC  C OTC 2lT(object)TCC6 G`( 2+<> = <>G`G`( T G`( .' $TC  6QJ >]]>IB >]]> /( NG <5 >]]>  G`G`( Ty-CCfC fCCfC f CCfC f CCfCf CCfCf CfO C' %C4g!>CrC& O   C]CQ FU! TOOPERATION LNSAVEAREA LCINPARMS LCOUTPARMSLCSTRLOPARMLCRETVAL LCRETVAL2 LEOUTVALUELERETVALTHIS OPENOFFLINE RETURNVALUE ISDATASET ISCOMPLEXITEM OWNERDOCUMENTXMLCOLPARMSISBYREF INPUTVALUEURIWSDLSERVICEPORT OPERATIONWSMETHODINPARMSTYPEOUTPARMSRETVALUE LASTUPDATEUNIQUEID      J( TCW%C zB-% G`( 2+<> = <>G`G`( Ty-CCfCfCCfCf CCfCf CCfCf CCfCf CfO C' %C4 Q FDT4Failed to find or load offline data for Web service.B-&T Cmsxml2.domdocument.4.0N%C  ~Q FDT4Failed to find or load offline data for Web service.B-TC parameters  xTCname !"TCtype !"#  H # C inputValue#$^TCtype# !"T #"$ C outputValue#$T #" Ht CgT C C% H4 CTCSafetyvG.rh1 C M M M MMMMTC M Q Ta:SET SAFETY &lSaveSafety % _TC2T"Failed to open offline cache file.T F B U TCMETHODNAMETCPARMS LNSAVEAREA LCOFFLINEDBF LHADERROR LSAVESAFETYTHIS COFFLINEALIAS OFFLINEDBFTYPEURISERVICEPORT OPERATIONINPARMSOUTPARMSRETVALUE LASTUPDATEUNIQUEIDUSER ERRORMESSAGE UTOTABLE UTOTABLE  %CN ; B%CC8Gb BC8 T(%C TTC T. T! BUTEVALUEI LNLASTVALUEpfBCteObject.LengthbNCteObject.item(0)bO &C IsDataSetCC 꾸 UTEOBJECTITEMXMLG=BCteObject.LengthbNCteObject.item(0)bO UTEOBJECT %C 7B- HH( CtoVFPObject.oComplexbUTCEMPTYNT COTCEMPTYN T2 T%COB-(!%C  }2CC  C    Ta B U TOVFPOBJECTTOXMLDOMNODELISTI LOVFPOBJECT LHADERRORTHIS ISCOMPLEXOCOMPLEXLENGTHITEMNODETYPENODENAMENODETYPEDVALUE_#  (%CtoOperation.oAdapterbOp B T%C  ( +%C fCC  fT TC6TC T %C  F C )%C  Ta!6% C CursorAdapter O T+C ;TT C_T  BUTOCLIENT TOOPERATIONTCCONTROLCLASS LNALIASIDILNCOUNT LBADSTUCTLOTABLEAFLDSLOFIELDLCALIASDSTABLEOADAPTERTABLESCOUNTITEMALIASFIELDSDSUSEEXISTINGCURSOR &%C CursorAdapter5B%C FC C%CCB-C%CCC CTCC#)U TOTABLE TOCONTROL BASECLASSALIASTHISBEFOREOPENCURSORTOCURSORAFTEROPENCURSORACURSORS%C z%CTHISFORMbOa*CActivate StartupInvokev CUTHISSETUPOPERATIONS LHASCLIENTSTHISFORM STARTUPINVOKEPTa% C EBTT CE M(` <>Location: <>#Number: <>Method: <>Message: <> Line: <><>,&Press OK to ignore error and continue.Press Cancel to close. T % B:%C XML Web Services Publisher Errorx> H: - G1 X CTHISFORMbO.< 2: B-U NERRORCMETHODNLINE LCERRORMSGTHIS LHADERROR LSKIPERROR STARTMODE ERRORNUMBER ERRORMESSAGE ERRORDETAILLDISPLAYERRORSTHISFORM%(CF%CC CCC  CC  FC QUITHISLAUTOCLOSECURSORSACURSORSinvoke, startupinvoket connectws calloperation wsobject_access setupclients invokeclient setupclient* getobjectref+ converttype. displayerror3 gendataset4 displaystatus]6setconnectorpropertiesz7setclientproperties7 callclients7recordws: playbackws=C openofflineKbeforeopencursorQPafteropencursorhP checknumberP isdatasetQ iscomplexR getcomplexdR gettableidT opendstableWInitYErrorYDestroy\1qrRqAAAQ3Aa!AAAqA11aaaaAAAAQARAAA2A2CqAAAQAb11aaaaABAABA2qrR"AAAARqAAX1AR21111111BA1AA1AAA2A2qbAA3q!AAAAAAAA!!qQAAAAqqAaaQAABqQAA2AAAABA#A21S#AAAAsAAA"AAAAQA3A1!AAAARTBBSb1r#rAqA!!1AA1A2AR!!1!!!ARqA1RA1AS1ABBAa!qAA213qAAAAA2ABrACA3rA"!AA!!!qA!!!aAA!q"!!A!q"!!AB2qqA3RqAARbBAAA3qAAaAQAAAAAA2<9qrR"AAAARqA"qaAAq2AAAA3qrQ"qA!QQAA!A1RRAB!!Aaa1!AA AAAAaaAB2qq"qAr!!AaaAAAqAbaAAqA!!1AAA1AbQqAA21"aAAAAqAA!AAAAAAB223AAS!aAACa1A11AAAAAAQa,AA!A3q4q4qAAAAAAA2qc3q2bqAQQARqA"AAA26A1AAA!AAAAdaAA2cAA3qAQAA2AA2tAA1a1qAaAqAAAAr3qbAAAAA2 I  `N8 fh%%Ao BB_BHhI}Q2Q R7-R VN-VW"dWY:e%Z[Ff[`O allx*x]gidkr~-Mʄވ 5>PW)`G8)BjCPROCEDURE invoke LPARAMETERS toOperation LOCAL lcMethod, leRetval, lcParms, lcByRefChar, loException, loParms, lHadError, laParms, i IF VARTYPE(toOperation)#"O" RETURN .F. ENDIF IF VARTYPE(THIS.lForceOffline)#"L" THIS.lForceOffline=.F. ENDIF lcMethod = toOperation.wsMethod loParms = toOperation.colParms * Get Parameters from parm collection object * and create parameter string for method call. lcParms = "" IF loParms.Count>0 * Need to create string here... DIMENSION laParms[loParms.Count] FOR i = 1 TO loParms.Count laParms[m.i] = "" lcByRefChar="" TRY * We pass form object here since parm source could be based on * a control property and we need to get its value and type. laParms[m.i] = loParms.GetParm(m.i, THIS) lcByRefChar=IIF(loParms.Item[m.i].IsByRef,"@","") CATCH ENDTRY lcParms = lcParms + lcByRefChar + "laParms[" + TRANSFORM(m.i) + "]" IF m.i < loParms.Count lcParms = lcParms + "," ENDIF ENDFOR ENDIF lcMethod = m.lcMethod+"("+ lcParms +")" * Call Service here THIS.lHadError = .F. leRetVal = "" TRY IF !THIS.lForceOffline AND THIS.ConnectWS() THIS.DisplayStatus(WAIT_QUERYWS_LOC) leRetVal = THIS.wsObject.&lcMethod. ENDIF CATCH TO loException THIS.lHadError = .T. THIS.ErrorNumber = loException.ErrorNo THIS.ErrorMessage = loException.Message IF !EMPTY(THIS.wsObject.FaultCode) THIS.SoapErrorCode = THIS.wsObject.FaultCode THIS.SoapErrorString = THIS.wsObject.FaultString THIS.SoapErrorDetail = THIS.wsObject.Detail ENDIF FINALLY THIS.DisplayStatus() ENDTRY lHadError = THIS.lHadError OR THIS.lForceOffline IF !lHadError * Populate return values in colParms collection (byref ones will be different than InputValue) FOR i = 1 TO loParms.Count TRY loParms.Item[m.i].AddProperty("ReturnValue", THIS.Checknumber(laParms[m.i])) CATCH ENDTRY ENDFOR * Update ReturnValues toOperation.lUsedOffline = .F. leRetVal=THIS.Checknumber(leRetVal) toOperation.ReturnValue = leRetVal THIS.ReturnValue = leRetVal * Record results if user wants offline IF toOperation.lOffline * Record the settings here THIS.RecordWS(toOperation) ENDIF ELSE IF THIS.lForceOffline OR toOperation.lOffline * Try to playback the settings here IF THIS.PlaybackWS(toOperation) toOperation.lUsedOffline = .T. lHadError=.F. ENDIF ENDIF ENDIF RETURN !lHadError ENDPROC PROCEDURE startupinvoke IF TYPE("THISFORM")="O" UNBINDEVENT(THISFORM, "Activate", THIS, "StartupInvoke") ENDIF THIS.SetupClients() ENDPROC PROCEDURE connectws LOCAL loSoapClient, i * Check core parameters IF VARTYPE(THIS.WSDL)#"C" OR EMPTY(THIS.WSDL) RETURN .F. ENDIF IF VARTYPE(THIS.Service)#"C" THIS.Service = "" ENDIF IF VARTYPE(THIS.Port)#"C" THIS.Port = "" ENDIF IF VARTYPE(THIS.WSML)#"C" OR ATC(".asmx?wsdl",THIS.WSDL)#0 * Only include WSML file if SOAP Toolkit XML Web service using custom type mapper. * Skip for all VS XML Web services. THIS.WSML = "" ENDIF * Create instance of SOAP object (default for nConnectTries = 2) FOR i = 1 TO THIS.nConnectTries THIS.lHadError = .F. THIS.ErrorDetail = "" THIS.ErrorMessage = "" THIS.ErrorNumber = 0 THIS.SoapErrorCode = "" THIS.SoapErrorString = "" THIS.SoapErrorDetail = "" THIS.DisplayStatus(WAIT_QUERYWS_LOC) TRY * SOAPCLIENT_CLASS => "MSSOAP.SoapClient30" THIS.wsObject = CREATEOBJECT(SOAPCLIENT_CLASS) THIS.SetClientProperties() THIS.wsObject.SOAPCLIENT_INIT(THIS.WSDL, THIS.Service, THIS.Port, THIS.WSML) THIS.SetConnectorProperties() CATCH TO loException THIS.lHadError = .T. THIS.ErrorNumber = loException.ErrorNo THIS.ErrorMessage = loException.Message DO CASE CASE VARTYPE(THIS.wsObject)#"O" THIS.ErrorDetail = ERR_BADSOAPCLASS_LOC CASE !EMPTY(THIS.wsObject.FaultCode) THIS.SoapErrorCode = THIS.wsObject.FaultCode THIS.SoapErrorString = THIS.wsObject.FaultString THIS.SoapErrorDetail = THIS.wsObject.Detail OTHERWISE THIS.ErrorDetail = ERR_OTHERSOAPERR_LOC ENDCASE ENDTRY THIS.Displaystatus() IF !THIS.lHadError OR m.i=THIS.nConnectTries EXIT ENDIF ENDFOR IF THIS.lHadError THIS.wsObject = "" ENDIF RETURN !THIS.lHadError ENDPROC PROCEDURE calloperation LPARAMETERS tcOperation LOCAL loOperation, lSuccess, lcErrString, loItem, loParmForm THIS.lSkiperror = .T. TRY * Check if key passed in first loOperation = THIS.colOperations(tcOperation) CATCH * If user passes in just name, look for it. FOR EACH loItem IN THIS.colOperations IF UPPER(loItem.wsOperation) == UPPER(tcOperation) loOperation = loItem THIS.lhaderror=.F. EXIT ENDIF ENDFOR ENDTRY THIS.lSkiperror = .F. IF VARTYPE(loOperation)#"O" RETURN .F. ENDIF * Skip if already called IF loOperation.lSkipWebServiceCall RETURN !loOperation.lHadError ENDIF * Handle parameters * nParmPrompt=1 -- user already input them via builder * nParmPrompt=2 -- user already input them via their own handling * set by loOperation.colParms(m.i).InputValue * nParmPrompt=3 -- prompt now (at runtime) IF loOperation.colParms.Count>0 AND loOperation.nParmPrompt=3 loParmForm = NEWOBJECT("wsParms",THIS.ClassLibrary) loParmForm.oColParms = loOperation.colParms loParmForm.SetupWS() loParmForm.Show(1) ENDIF lSuccess = THIS.Invoke(loOperation) loOperation.ReturnValue = THIS.ReturnValue loOperation.lHadError = THIS.lHadError IF !lSuccess loOperation.SoapErrorCode = THIS.SoapErrorCode loOperation.SoapErrorString = THIS.SoapErrorString loOperation.SoapErrorDetail = THIS.SoapErrorDetail loOperation.ErrorNumber = THIS.ErrorNumber loOperation.ErrorMessage = THIS.ErrorMessage loOperation.ErrorDetail = THIS.ErrorDetail lcErrString = INVOKE_ERROR_LOC+CRLF+CRLF DO CASE CASE !EMPTY(THIS.SoapErrorString) AND THIS.lVerboseError lcErrString = lcErrString+THIS.SoapErrorDetail CASE !EMPTY(THIS.SoapErrorString) lcErrString = lcErrString+THIS.SoapErrorString CASE !EMPTY(THIS.ErrorDetail) AND THIS.lVerboseError lcErrString = lcErrString+THIS.ErrorDetail CASE !EMPTY(THIS.ErrorMessage) lcErrString = lcErrString+THIS.ErrorMessage OTHERWISE lcErrString = ALLTRIM(lcErrString) ENDCASE THIS.DisplayError(lcErrString) ENDIF RETURN lSuccess ENDPROC PROCEDURE wsobject_access IF TYPE("THIS.wsobject")#"O" THIS.Connectws() ENDIF RETURN THIS.wsobject ENDPROC PROCEDURE setupclients LOCAL loOperation, loClient, lcKey, lnCount, loObject, lnCount2, lcKey2, lnFlags, lcProp LOCAL i, lnObjects, lcName IF TYPE("THIS.colOperations")#"O" RETURN ENDIF * Need to resolve container reference if WSHandler is from a non-form container class. IF !EMPTY(THIS.cContainer) lnObjects=GETWORDCOUNT(THIS.cContainer,".") loObject = THIS FOR i = lnObjects TO 1 STEP -1 lcName = GETWORDNUM(THIS.cContainer, m.i, ".") IF UPPER(lcName)==UPPER(loObject.Name) AND TYPE("loObject.Parent")="O" AND m.i#1 loObject = loObject.Parent LOOP ENDIF lcName = IIF(m.i#1, "", loObject.Name) ENDFOR DO WHILE !EMPTY(lcName) IF TYPE("loObject.Parent")#"O" OR UPPER(loObject.Parent.BaseClass)=="FORMSET" EXIT ENDIF loObject = loObject.Parent lcName = loObject.Name+"."+lcName ENDDO THIS.cContainer=lcName loObject="" ENDIF * Setup client bindings lnCount=1 FOR EACH loOperation IN THIS.colOperations lcKey=THIS.colOperations.GetKey(lnCount) lnCount2=1 FOR EACH loClient IN loOperation.colClients * Get object reference based on Builder setting lcKey2=loOperation.colClients.GetKey(lnCount2) loClient.ADDPROPERTY("OperationID", lcKey) loObject = THIS.GetObjectRef(loClient.ObjectRef) IF VARTYPE(loObject) # "O" LOOP ENDIF lcProp = loClient.BindProp IF PEMSTATUS(loObject, lcProp+PROPKEY_SUFFIX, 5) AND !PEMSTATUS(loObject, lcProp,4) THIS.DisplayError(MB_UNIQUEPEM2_LOC+CRLF+CRLF+ ; loObject.Name+"."+lcProp+CRLF+CRLF+MB_UNIQUEPEM_LOC) LOOP ENDIF DO CASE CASE !PEMSTATUS(loObject, lcProp, 5) ADDPROPERTY(loObject, lcProp , .F.) CASE ATC("Property", PEMSTATUS(loObject, lcProp,3))#0 ADDPROPERTY(loObject, lcProp , .F.) ENDCASE DO CASE CASE VARTYPE(loClient.BindFlags)#"N" OR loClient.BindFlags<0 IF ATC("CursorAdapter", loObject.BaseClass)#0 lnFlags=1 ELSE lnFlags=IIF(ATC("Property", PEMSTATUS(loObject, lcProp,3))#0, 1, 0) ENDIF OTHERWISE lnFlags = loClient.BindFlags ENDCASE BINDEVENT(loObject, lcProp, THIS, "InvokeClient", lnFlags) ADDPROPERTY(loObject, lcProp + PROPKEY_SUFFIX , lcKey2) IF loClient.lInvokeAtStart THIS.cLastEvent = lcProp DO CASE CASE ATC("Property", PEMSTATUS(loObject, lcProp,3))#0 loObject.&lcProp. = .T. CASE ATC("CursorFill", lcProp)#0 AND ATC("CursorAdapter",loObject.BaseClass)#0 * Need to explicitly call the method. RaiseEvent will not cause table to fill. loObject.CursorFill() IF !EMPTY(ALIAS()) GO TOP IF !THISFORM.BindControls AND THIS.lAutoBindControls THISFORM.BindControls=.T. ENDIF ENDIF OTHERWISE IF PEMSTATUS(loObject, lcProp, 4) OR ; (VARTYPE(THIS.lUseRaiseEvents)="L" AND THIS.lUseRaiseEvents) RAISEEVENT(loObject, lcProp) ELSE loObject.&lcProp ENDIF ENDCASE loOperation.lSkipWebServiceCall=.T. ENDIF lnCount2=lnCount2+1 ENDFOR lnCount=lnCount+1 ENDFOR * Reset the skip setting from startups FOR EACH loOperation IN THIS.colOperations loOperation.lSkipWebServiceCall=.F. ENDFOR ENDPROC PROCEDURE invokeclient LPARAMETERS p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16 * Had an event here. Note: since this gets invoked via BINDEVENT(), we do not * worry about return value of this method. LOCAL laEventInfo, laEventsAll, i, loClient, loOperation, lcKey, lcCursor LOCAL leRetVal, loParm, lcBindSource, loErr, lcErrMsg, loControl, loField LOCAL leRetType, lePropType, lcNode, lcTmpErrMsg, lcTarget, lcProp LOCAL lnAliasID, lnSaveArea, lcField, loTable, lHadError, lcNodeName DIMENSION laEventInfo[1] DIMENSION laEventsAll[1] lcTarget="" lcBindSource = "" lcTmpErrMsg="" * Need to find out which delegate got called and event (method) name. AEVENTS(laEventInfo, 0) loControl = laEventInfo[1] lcProp = laEventInfo[2] * Get client and Operation objects here lcKey = lcProp + PROPKEY_SUFFIX lcKey = loControl.&lcKey. THIS.cLastEvent = "" * Get client FOR EACH loOperation in THIS.colOperations FOR i = 1 TO loOperation.colClients.Count IF loOperation.colClients.GetKey(m.i)==lcKey loClient = loOperation.colClients.Item(m.i) EXIT ENDIF ENDFOR ENDFOR * Get operation and binding properties loOperation = THIS.colOperations(loClient.OperationID) lcTarget = loClient.BindTarget lcBindSource = loClient.BindSource IF loClient.lAlwaysCallWebService loOperation.lSkipWebServiceCall = .F. ENDIF * Invoke actual Web Service here -- THIS.ReturnValue has raw results IF !THIS.CallOperation(loClient.OperationID) RETURN ENDIF * Need to get binding source (ReturnValue or one of the parms -- typically passed byref) leRetVal=loOperation.ReturnValue IF ATC("ReturnValue", lcBindSource )=0 * Need to get the parameter value. FOR EACH loParm IN loOperation.colParms IF UPPER(loParm.ParmName)==UPPER(lcBindSource) leRetVal = loParm.ReturnValue EXIT ENDIF ENDFOR ENDIF leRetType = VARTYPE(leRetVal) lnSaveArea=SELECT() * Handle preprocessing for certain complex types here TRY DO CASE CASE THIS.IsDataset(leRetVal) * Handle Dataset here and populate XMLAdapter IF !THIS.GenDataSet(leRetVal, THIS) lcTmpErrMsg=ERROR_GENDATASET_LOC ERROR 0 ENDIF * Set adapter here loOperation.oAdapter = THIS.oAdapter * Get Table ID and reference lnAliasID = THIS.GetTableID(loClient, loOperation, loControl.Baseclass) loTable = loOperation.oAdapter.Tables.Item(lnAliasID) * Populate cursor from adapter IF !THIS.OpenDSTable(loTable, loControl) lcTmpErrMsg=ERROR_OPENCURSOR_LOC ERROR 0 ENDIF * Validate and get field name lcField = "" IF !EMPTY(loClient.DSField) FOR EACH loField IN loTable.Fields IF UPPER(loClient.DSField) == UPPER(loField.Alias) lcField = loClient.DSField EXIT ENDIF ENDFOR ENDIF lcField = IIF(!EMPTY(lcField), lcField, loTable.Fields.Item(1).Alias) CASE THIS.IsComplex(leRetVal) * Create Fox object from XMLDOMNodeList object * Sets it to loOperation.oComplex THIS.GetComplex(loOperation, leRetVal) ENDCASE CATCH lHadError=.T. ENDTRY * Main segment to handle binding (both simple and complex types) TRY DO CASE CASE lHadError * Skip if we had an error earlier and don't bind CASE THIS.IsDataset(leRetVal) AND ATC("CursorAdapter", loControl.BaseClass)#0 * Special handling for CursorAdapter since we won't be binding specifically to controls SET MULTILOCKS ON loControl.DataSourceType = "XML" loControl.AddProperty("oAdapter_WS", loTable) loControl.SelectCMD = [THIS.oAdapter_WS] CASE EMPTY(ALLTRIM(lcTarget)) OR ATC(WSNONE_LOC, lcTarget)#0 * Skip rest if not Target property specified CASE leRetType # "O" * Handle simple primitive data binding here -- most cases IF !PEMSTATUS(loControl, lcTarget, 4) * Handle type conversion here. Check only for native properties * since we may need to convert type. Skip for custom properties. lePropType = VARTYPE(loControl.&lcTarget) leRetVal = THIS.ConvertType(leRetVal, leRetType, lePropType) ENDIF * Let's do some special handling for Web Services which return large XML string that can be converted to a Table. IF (ATC("RecordSource", lcTarget)#0 OR ATC("ControlSource", lcTarget)#0 OR UPPER(lcTarget)=="VALUE") AND ; VARTYPE(leRetVal)="C" AND LOWER(LEFT(ALLTRIM(leRetVal),5))="> Property: <> <> ENDTEXT THIS.Displayerror(lcErrMsg) ENDIF ENDPROC PROCEDURE setupclient LPARAMETERS lcURI, lcService, lcPort, lcWSML THIS.WSDL = lcUri THIS.Service = lcService THIS.Port = lcPort THIS.WSML = lcWSML RETURN THIS.wsObject ENDPROC PROCEDURE getobjectref LPARAMETERS tcObjectRef * Returns valid object reference based on the path passed in. * ex. Form1.PageFrame1.Page1.Text1 LOCAL lcObject, loControl DO CASE CASE TYPE("THISFORM")#"O" loControl =THIS DO WHILE .T. IF TYPE("loControl.Parent")#"O" EXIT ENDIF loControl = loControl.Parent ENDDO CASE TYPE("THISFORMSET.DataEnvironment")="O" AND ; UPPER(THISFORMSET.DataEnvironment.Name) == UPPER(GETWORDNUM(tcObjectRef,1,".")) loControl = THISFORMSET.DataEnvironment CASE TYPE("THISFORM.DataEnvironment")="O" AND ; UPPER(THISFORM.DataEnvironment.Name) == UPPER(GETWORDNUM(tcObjectRef,1,".")) loControl = THISFORM.DataEnvironment CASE !EMPTY(THISFORM.DEClass) AND ; UPPER(THISFORM.DEClass) == UPPER(GETWORDNUM(tcObjectRef,1,".")) loControl = THISFORM.DEClass loControl = THISFORM.&loControl. OTHERWISE * For runtime, we require active form/toolbox loControl = THISFORM * Fix up if we have a container IF !EMPTY(THIS.cContainer) tcObjectRef=THIS.cContainer+IIF( ATC(".",tcObjectRef)=0,"", SUBSTRC(tcObjectRef, ATC(".", tcObjectRef)) ) ENDIF ENDCASE IF ATC(".",tcObjectRef)#0 lcObject = SUBSTRC(tcObjectRef, ATC(".", tcObjectRef)+1) IF TYPE("loControl.&lcObject.")="O" RETURN loControl.&lcObject. ENDIF * Could not find the object reference - one of the * names along path was changed or an item removed. RETURN ENDIF * Otherwise, let's assume that we are just referring to the form or DE, * but don't check for name since subclass of form could change. RETURN loControl ENDPROC PROCEDURE converttype LPARAMETERS teInputValue, tcInputtype, tcOutputtype LOCAL leRetVal DO CASE CASE !THIS.lAutoConvert RETURN teInputValue CASE PCOUNT()#3 OR VARTYPE(tcInputtype)#"C" OR VARTYPE(tcOutputtype)#"C" RETURN teInputValue CASE tcInputtype=tcOutputtype RETURN teInputValue ENDCASE leRetVal = teInputValue * Handle type conversion here DO CASE CASE tcInputtype=tcOutputtype OR !THIS.lAutoConvert * Do nothing -- if lAutoConvert=.F., then invalid type gets caught by error handler. CASE tcOutputtype = "C" && String IF tcInPutType="L" leRetVal = IIF(leRetVal, TRUE_LOC, FALSE_LOC) ELSE leRetVal = TRANSFORM(leRetVal) ENDIF CASE tcOutputtype = "N" && Numeric DO CASE CASE tcInPutType="C" leRetVal = VAL(leRetVal) CASE tcInPutType="L" leRetVal = IIF(leRetVal, 1, 0) CASE INLIST(tcInPutType, "D", "T") * Return Julian value leRetVal = ROUND(VAL(SYS(11, leRetVal)),0) OTHERWISE leRetVal = .F. ENDCASE CASE tcOutputtype = "L" && Logical DO CASE CASE tcInPutType="N" leRetVal = IIF(leRetVal=0, .F., .T.) CASE tcInPutType="C" DO CASE CASE ATC(TRUE_LOC, leRetVal)#0 OR ATC(YES_LOC, leRetVal)#0 leRetVal= .T. CASE ATC(FALSE_LOC, leRetVal)#0 OR ATC(NO_LOC, leRetVal)#0 OR EMPTY(leRetVal) leRetVal= .F. CASE ISDIGIT(leRetVal) leRetVal=IIF(VAL(leRetVal)=0,.F.,.T.) OTHERWISE leRetVal=IIF(ISALPHA(leRetVal),.F.,EVALUATE(leRetVal)) ENDCASE OTHERWISE leRetVal = .F. ENDCASE CASE tcOutputtype = "D" && Date DO CASE CASE tcInPutType = "N" AND BETWEEN(leRetVal , 1721119, 5373484) * Handle Julian types leRetVal = SYS(10, leRetVal) CASE tcInPutType = "T" leRetVal = TTOD(leRetVal) CASE tcInPutType = "C" leRetVal = CTOD(leRetVal) OTHERWISE leRetVal = DATE() ENDCASE CASE tcOutputtype = "T" && Time DO CASE CASE tcInPutType = "N" AND BETWEEN(leRetVal , 1721119, 5373484) * Handle Julian types leRetVal = SYS(10, leRetVal) CASE tcInPutType = "D" leRetVal = DTOT(leRetVal) CASE tcInPutType = "C" leRetVal = CTOT(leRetVal) OTHERWISE leRetVal = DATETIME() ENDCASE OTHERWISE * Not supported ENDCASE RETURN leRetVal ENDPROC PROCEDURE displayerror LPARAMETERS tcErrMessage IF THIS.lDisplayErrors MESSAGEBOX(tcErrMessage, 0, MB_SOAPERRTITLE_LOC) ENDIF ENDPROC PROCEDURE gendataset LPARAMETERS tcXMLSource, toSource * tcXMLSource - reference to XMLDOMNodeList object * toSource - object which has oAdapter property to create XMLAdapter object LOCAL lHadError, lcClass, lcClassLib IF VARTYPE(tcXMLSource)#"O" * Check if return already value has it in case the tcXMLSource doesn't. IF TYPE("toSource.ReturnValue.Length")#"N" RETURN .F. ENDIF tcXMLSource=toSource.ReturnValue ENDIF TRY lcClass=IIF(VARTYPE(THIS.XMLAdapterClass)#"C" OR EMPTY(THIS.XMLAdapterClass), ; "xmlAdapter", THIS.XMLAdapterClass) lcClassLib=IIF(VARTYPE(THIS.XMLAdapterClassLib)#"C" OR EMPTY(THIS.XMLAdapterClassLib), ; "", THIS.XMLAdapterClassLib) toSource.oAdapter = NEWOBJECT(lcClass,lcClassLib) IF tcXMLSource.Length=1 toSource.oAdapter.Attach(tcXMLSource.Item(0)) ELSE toSource.oAdapter.Attach(tcXMLSource.Item(1), tcXMLSource.Item(0)) ENDIF lHadError = toSource.oAdapter.Tables.Count=0 CATCH lHadError=.T. ENDTRY RETURN !lHadError ENDPROC PROCEDURE displaystatus LPARAMETERS lcMsg IF VARTYPE(THIS.Displaymode)#"N" THIS.Displaymode=0 ENDIF IF VARTYPE(lcMsg)#"C" OR EMPTY(lcMsg) DO CASE CASE THIS.Displaymode=0 SET MESSAGE TO CASE THIS.Displaymode=1 WAIT CLEAR OTHERWISE ENDCASE RETURN ENDIF DO CASE CASE THIS.Displaymode=0 SET MESSAGE TO lcMsg CASE THIS.Displaymode=1 WAIT WINDOW lcMsg NOWAIT OTHERWISE ENDCASE ENDPROC PROCEDURE setconnectorproperties * This is a virtual method after before MSSoapInit routine of SoapClient * It is typically used to set ConnectorProperty settings. You can access the * SOAP object using THIS.wsObject as your object reference. * * ex. THIS.wsObject.ConnectorProperty("Timeout") = 10000 * ex. THIS.wsObject.ConnectorProperty("ProxyUser") = myUser * ex. THIS.wsObject.ConnectorProperty("ProxyPassword") = myPassword * ex. THIS.wsObject.ConnectorProperty("EnableAutoProxy") = .T. * * See SOAP Toolkit 3.0 help for more details on ConnectorProperty property. ENDPROC PROCEDURE setclientproperties * This is a virtual method called before MSSoapInit routine of SoapClient * It is typically used to set ClientProperty settings. You can access the * SOAP object using THIS.wsObject as your object reference. * * ex. THIS.wsObject.ClientProperty("ServerHTTPRequest") = .T. * * See SOAP Toolkit 3.0 help for more details on ClientProperty property. ENDPROC PROCEDURE callclients LPARAMETERS tcOperation LOCAL loOperation, loClient, loObject, lcProp, loItem THIS.lSkiperror = .T. TRY * Check if key passed in first loOperation = THIS.colOperations(tcOperation) CATCH * If user passes in just name, look for it. FOR EACH loItem IN THIS.colOperations IF UPPER(loItem.wsOperation) == UPPER(tcOperation) loOperation = loItem THIS.lhaderror=.F. EXIT ENDIF ENDFOR ENDTRY THIS.lSkiperror = .F. IF VARTYPE(loOperation)#"O" RETURN .F. ENDIF FOR EACH loClient IN loOperation.colClients * Get object reference based on Builder setting lcProp = loClient.BindProp loObject = THIS.GetObjectRef(loClient.ObjectRef) IF VARTYPE(loObject)#"O" OR !PEMSTATUS(loObject, lcProp,5) LOOP ENDIF THIS.cLastEvent = lcProp DO CASE CASE ATC("Property", PEMSTATUS(loObject, lcProp,3))#0 loObject.&lcProp. = .T. CASE ATC("CursorFill", lcProp)#0 AND ATC("CursorAdapter",loObject.BaseClass)#0 * Need to explicitly call the method. RaiseEvent will not cause table to fill. loObject.CursorFill() OTHERWISE IF PEMSTATUS(loObject, lcProp, 4) OR ; (VARTYPE(THIS.lUseRaiseEvents)="L" AND THIS.lUseRaiseEvents) RAISEEVENT(loObject, lcProp) ELSE loObject.&lcProp ENDIF ENDCASE loOperation.lSkipWebServiceCall=.T. ENDFOR loOperation.lSkipWebServiceCall=.F. ENDPROC PROCEDURE recordws LPARAMETERS toOperation LOCAL lnSaveArea, lcInParms, lcOutParms, lcStr, loParm, lcRetVal, lcRetVal2, leOutValue, leRetVal STORE "" TO lcInParms, lcOutParms, lcRetVal lnSaveArea = SELECT() lcRetVal2="" IF !THIS.OpenOffline() RETURN .F. ENDIF * Get Return Value DO CASE CASE VARTYPE(toOperation.ReturnValue)="U" lcRetVal="" CASE VARTYPE(toOperation.ReturnValue)#"O" lcRetVal=TRANSFORM(toOperation.ReturnValue) OTHERWISE lcRetVal=OFFLINE_OBJREF_LOC leRetVal=toOperation.ReturnValue DO CASE CASE THIS.IsDataset(leRetVal) * Handle dataset TEXT TO lcStr TEXTMERGE NOSHOW PRETEXT 2 <> <> ENDTEXT lcRetVal2=STRCONV(lcStr,11) CASE THIS.IsComplex(leRetVal) * Handle complex object lcRetVal2 = leRetVal.item(0).ownerDocument.xml OTHERWISE * COM Objects are not supported. lcRetVal=OFFLINE_OBJREF_LOC ENDCASE ENDCASE lcRetVal2=IIF(EMPTY(lcRetVal2), lcRetVal ,lcRetVal2) * Get Parameters and return value * Get content for InParms field SET TEXTMERGE ON TO MEMVAR lcStr NOSHOW FOR EACH loParm IN toOperation.colParms \<> = <> ENDFOR SET TEXTMERGE OFF SET TEXTMERGE TO lcInParms=lcStr * Get content for OutParms fields SET TEXTMERGE ON TO MEMVAR lcStr NOSHOW \ \ FOR EACH loParm IN toOperation.colParms leOutValue = IIF(loParm.IsByRef, loParm.ReturnValue, loParm.InputValue) \ \ >]]> \ >]]> \ ENDFOR \ \ \ >]]> \ \ SET TEXTMERGE OFF SET TEXTMERGE TO lcOutParms=lcStr LOCATE FOR ALLTRIM(UPPER(URI)) == UPPER(THIS.WSDL) AND ; ALLTRIM(UPPER(Service)) == UPPER(THIS.Service) AND ; ALLTRIM(UPPER(Port)) == UPPER(THIS.Port) AND ; ALLTRIM(UPPER(Operation)) == UPPER(toOperation.wsMethod) AND ; ALLTRIM(UPPER(InParms)) == UPPER(lcInParms) AND ; UPPER(type)="O" AND !DELETE() IF FOUND() REPLACE OutParms WITH lcOutParms,; RetValue WITH lcRetVal2,; LastUpdate WITH DATETIME() ELSE INSERT INTO (DBF()) (Type, Uri, Service, Port, Operation, InParms, OutParms, RetValue, UniqueID, LastUpdate) ; VALUES( ; "O", ; THIS.WSDL,; THIS.Service,; THIS.Port,; toOperation.wsMethod,; lcInParms,; lcOutParms,; lcRetVal2,; SYS(2015),; DATETIME() ) ENDIF USE SELECT (lnSaveArea) ENDPROC PROCEDURE playbackws LPARAMETERS toOperation LOCAL lnSaveArea, lcInParms, lcStr LOCAL loParm, lcParmName, lcParmType, lcParmStyle, loDOM2 LOCAL lcInputValue, lcOutputValue, leValue, loDOM, loParmNode, loParmNodes STORE "" TO lcInParms lnSaveArea = SELECT() IF !THIS.OpenOffline() RETURN .F. ENDIF IF toOperation.colParms.Count>0 SET TEXTMERGE ON TO MEMVAR lcStr NOSHOW FOR EACH loParm IN toOperation.colParms \<> = <> ENDFOR SET TEXTMERGE OFF SET TEXTMERGE TO lcInParms=lcStr ENDIF LOCATE FOR ALLTRIM(UPPER(URI)) == UPPER(THIS.WSDL) AND ; ALLTRIM(UPPER(Service)) == UPPER(THIS.Service) AND ; ALLTRIM(UPPER(Port)) == UPPER(THIS.Port) AND ; ALLTRIM(UPPER(Operation)) == UPPER(toOperation.wsMethod) AND ; ALLTRIM(UPPER(InParms)) == UPPER(lcInParms) AND ; UPPER(type)="O" AND !DELETE() IF !FOUND() USE SELECT (lnSaveArea) THIS.ErrorMessage=ERROR_FAILOFFLINE2_LOC RETURN .F. ENDIF loDOM = CREATEOBJECT(MSXML4_CLASS) IF !loDOM.LoadXML(OutParms) USE SELECT (lnSaveArea) THIS.ErrorMessage=ERROR_FAILOFFLINE2_LOC RETURN .F. ENDIF loParmNodes = loDOM.selectSingleNode("parameters") FOR EACH loParmNode IN loParmNodes.ChildNodes lcParmName = loParmNode.attributes.getNamedItem("name").text lcParmStyle = loParmNode.attributes.getNamedItem("type").text FOR EACH loPart IN loParmNode.ChildNodes DO CASE CASE ATC("inputValue", loPart.nodeName)#0 lcParmType = loPart.attributes.getNamedItem("type").text lcInputValue = loPart.text CASE ATC("outputValue", loPart.nodeName)#0 lcOutputValue = loPart.text ENDCASE ENDFOR DO CASE CASE VAL(lcParmStyle)=3 && return value * Check if we have an object leValue = THIS.ConvertType(lcOutputValue,"C", lcParmType) DO CASE CASE ATC("1 leValue = loDom2.childNodes.Item(1).childNodes ENDIF ENDIF CASE ATC("0 leValue = loDOM2.RpcResult.childNodes ELSE IF TYPE("loDOM2.RpcStruct.nextSibling.childNodes")="O" AND; loDOM2.RpcStruct.nextSibling.childNodes.Length>0 leValue = loDOM2.RpcStruct.nextSibling.childNodes ENDIF ENDIF ENDIF ENDCASE toOperation.ReturnValue = leValue THIS.ReturnValue = leValue OTHERWISE && parms IF LEFT(lcOutputValue, 1) = "=" lcOutputValue = EVALUATE(SUBSTR(lcOutputValue,2)) lcOutputValue=TRANSFORM(lcOutputValue) ENDIF leValue = THIS.ConvertType(lcOutputValue,"C", lcParmType) FOR EACH loParm IN toOperation.colParms IF loParm.ParmName==lcParmName loParm.AddProperty("ReturnValue", leValue) EXIT ENDIF ENDFOR ENDCASE ENDFOR USE SELECT (lnSaveArea) ENDPROC PROCEDURE openoffline LPARAMETERS tcMethodName, tcParms LOCAL lnSaveArea, lcOfflineDBF, lHadError, lSaveSafety * Check if Offline already opened IF !EMPTY(THIS.cOfflineAlias) AND SELECT(THIS.cOfflineAlias)#0 SELECT (THIS.cOfflineAlias) RETURN ENDIF lnSaveArea = SELECT() * Get offline file name IF VARTYPE(THIS.OfflineDBF)="C" AND !EMPTY(THIS.OfflineDBF) lcOfflineDBF=THIS.OfflineDBF IF EMPTY(JUSTEXT(lcOfflineDBF)) lcOfflineDBF=FORCEEXT(lcOfflineDBF,"DBF") ENDIF ELSE lcOfflineDBF=FOXWS_OFFLINE_DBF ENDIF * Get offline file path IF JUSTFNAME(lcOfflineDBF)==lcOfflineDBF DO CASE CASE FILE(_FOXCODE) lcOfflineDBF=ADDBS(JUSTPATH(_FOXCODE)) + lcOfflineDBF CASE DIRECTORY(HOME(7)) AND FILE(HOME(7) + lcOfflineDBF) lcOfflineDBF=HOME(7) + lcOfflineDBF CASE FILE(HOME() + lcOfflineDBF) lcOfflineDBF=HOME() + lcOfflineDBF CASE DIRECTORY(HOME(7)) lcOfflineDBF=HOME(7) + lcOfflineDBF OTHERWISE lcOfflineDBF=HOME() + lcOfflineDBF ENDCASE ENDIF * Try to open file here SELECT 0 IF FILE(lcOfflineDBF) TRY USE (lcOfflineDBF) SHARED AGAIN IF ATC("Type", FIELD(1))=0 OR ATC("URI", FIELD(2))=0 USE lHadError = .T. ENDIF CATCH lHadError = .T. ENDTRY ELSE lSaveSafety= SET("Safety") SET SAFETY OFF TRY CREATE TABLE (lcOfflineDBF) (; TYPE c(1),; URI m,; Service m,; Port m,; Operation m,; InParms m,; OutParms m,; RetValue m,; LastUpdate t,; UniqueID c(10),; User m) USE (lcOfflineDBF) SHARED AGAIN CATCH lHadError=.T. FINALLY SET SAFETY &lSaveSafety ENDTRY ENDIF IF !lHadError THIS.cOfflinealias = ALIAS() ELSE THIS.ErrorMessage=ERROR_FAILOFFLINE_LOC THIS.cOfflinealias = "" SELECT (lnSaveArea) ENDIF RETURN !lHadError ENDPROC PROCEDURE beforeopencursor LPARAMETERS toTable * Virtual method that gets called before cursor opened from XMLAdapter. * This routine gets called when Web service returns an ADO .Net Dataset. ENDPROC PROCEDURE afteropencursor LPARAMETERS toTable * Virtual method that gets called after cursor opened from XMLAdapter. * This routine gets called when Web service returns an ADO .Net Dataset. ENDPROC PROCEDURE checknumber LPARAMETERS teValue * This routine handles floats and fixes up unneeded extra decimals LOCAL i, lnLastValue IF VARTYPE(teValue)#"N" OR teValue=0 RETURN teValue ENDIF * Quick check for integer first IF MOD(INT(teValue), teValue)=0 RETURN INT(teValue) ENDIF * Reduce out extra decimals lnLastValue = teValue FOR i = 18 TO 1 STEP -1 IF ROUND(teValue, m.i)-teValue=0 lnLastValue = ROUND(teValue, m.i) LOOP ENDIF teValue = lnLastValue EXIT ENDFOR RETURN teValue ENDPROC PROCEDURE isdataset LPARAMETERS teObject RETURN TYPE("teObject.Length")="N" AND TYPE("teObject.item(0)")="O" AND ; ATC("IsDataSet", STRCONV(teObject.item(0).xml,9))#0 ENDPROC PROCEDURE iscomplex LPARAMETERS teObject RETURN TYPE("teObject.Length")="N" AND TYPE("teObject.item(0)")="O" ENDPROC PROCEDURE getcomplex LPARAMETERS toVFPObject, toXMLDomNodeList * Converts a complex type (XMLDomNodeList) returned by SOAP Web service to a VFP object. LOCAL i, loVFPObject, lHadError IF !THIS.IsComplex(toXMLDomNodeList) RETURN .F. ENDIF DO CASE CASE TYPE("toVFPObject.oComplex")#"U" && if Operation object passed toVFPObject.oComplex = CREATEOBJECT("EMPTY") loVFPObject=toVFPObject.oComplex CASE VARTYPE(toVFPObject)#"O" && user passed in ref for object toVFPObject=CREATEOBJECT("EMPTY") loVFPObject=toVFPObject OTHERWISE * assume user wants to add PEMs to existing object loVFPObject=toVFPObject ENDCASE IF VARTYPE(loVFPObject)#"O" RETURN .F. ENDIF * Create object PEMs here and set their values. TRY FOR i = 1 TO toXMLDomNodeList.Length IF toXMLDomNodeList.Item(m.i-1).nodeType = 1 ADDPROPERTY(loVFPObject, toXMLDomNodeList.item(m.i-1).nodeName, ; toXMLDomNodeList.item(m.i-1).nodeTypedValue) ENDIF ENDFOR CATCH lHadError=.T. ENDTRY RETURN !lHadError ENDPROC PROCEDURE gettableid LPARAMETERS toClient, toOperation, tcControlClass * This routine returns the Table id (index) in XMLTables collection based on the DSTable property. * It also checks if there is already an alias with same name in use and validates its structure. If * the structure is bad or user always wants to open up new cursor, then we rename alias. LOCAL lnAliasID, i, lnCount, lBadStuct, loTable, aflds, loField, lcAlias DIMENSION aflds[1] IF TYPE("toOperation.oAdapter")#"O" RETURN 0 ENDIF lnAliasID=0 IF !EMPTY(toClient.DSTable) FOR i = 1 TO toOperation.oAdapter.Tables.Count IF UPPER(toClient.DSTable) == UPPER(toOperation.oAdapter.Tables.Item(m.i).Alias) lnAliasID = m.i ENDIF ENDFOR ENDIF lnAliasID=IIF(lnAliasID=0, 1, lnAliasID) loTable = toOperation.oAdapter.Tables.Item(lnAliasID) lcAlias = loTable.Alias * If alias is already used, then we need to validate it IF USED(lcAlias) SELECT (lcAlias) AFIELDS(aflds) FOR EACH loField IN loTable.Fields IF ASCAN(aFlds, loField.Alias, -1, -1, 1, 7)=0 * Stucture is different, so need to open as new alias lBadStuct=.T. EXIT ENDIF ENDFOR ENDIF * If invalid structure, get new alias name - same as always open new * If we have a CursorAdapter, let it handle the alias conflict itself IF (lBadStuct OR !toClient.DSUseExistingCursor) AND ATC("CursorAdapter", tcControlClass)=0 lnCount=1 DO WHILE USED(lcAlias) lnCount=lnCount+1 lcAlias = loTable.Alias+TRANSFORM(lnCount) ENDDO loTable.Alias = lcAlias ENDIF RETURN lnAliasID ENDPROC PROCEDURE opendstable LPARAMETERS toTable, toControl * Do not open table for CursorAdapter -- let adapter do it (CursorFill) IF ATC("CursorAdapter", toControl.BaseClass)#0 RETURN ENDIF * Populate cursor from adapter IF !USED(toTable.Alias) SELECT 0 THIS.BeforeOpenCursor(toTable) toTable.ToCursor() IF EMPTY(ALIAS()) RETURN .F. ELSE THIS.AfterOpenCursor(toTable) IF !EMPTY(THIS.aCursors[ALEN(THIS.aCursors)]) DIMENSION THIS.aCursors[ALEN(THIS.aCursors)+1] ENDIF THIS.aCursors[ALEN(THIS.aCursors)] = ALIAS() GO TOP ENDIF ENDIF ENDPROC PROCEDURE Init IF THIS.SetupOperations() AND THIS.lHasClients IF TYPE("THISFORM")="O" BINDEVENT(THISFORM, "Activate", THIS, "StartupInvoke") ELSE THIS.StartupInvoke() ENDIF ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine #DEFINE DEBUGMODE .F. LOCAL lcErrorMsg THIS.lhaderror=.T. IF THIS.lSkiperror OR _VFP.StartMode>0 RETURN ENDIF THIS.ErrorNumber = nError THIS.ErrorMessage = MESSAGE() TEXT TO lcErrorMsg NOSHOW TEXTMERGE <> ERR_LOCATION_LOC <> ERR_NUMBER_LOC <> ERR_METHOD_LOC <> ERR_MESSAGE_LOC <> ERR_LINE_LOC <> <> ERR_MSG1_LOC ERR_MSG2_LOC ENDTEXT THIS.ErrorDetail = lcErrorMsg IF THIS.lDisplayErrors IF MESSAGEBOX(lcErrorMsg, 17, MB_ERRTITLE_LOC) # 1 DO CASE CASE DEBUGMODE SET STEP ON RETRY CASE TYPE("THISFORM")="O" RELEASE THISFORM OTHERWISE CANCEL ENDCASE ENDIF ENDIF RETURN .F. ENDPROC PROCEDURE Destroy LOCAL i IF THIS.lAutoCloseCursors FOR i = 1 TO ALEN(THIS.aCursors) IF VARTYPE(THIS.aCursors[m.i])="C" AND ; !EMPTY(THIS.aCursors[m.i]) AND USED(THIS.aCursors[m.i]) SELECT (THIS.aCursors[m.i]) USE ENDIF ENDFOR ENDIF ENDPROC